home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff1.arc / COMLIB.PAS < prev    next >
Pascal/Delphi Source File  |  1984-11-01  |  6KB  |  228 lines
  1.  
  2. {$U+}
  3.  
  4.   var
  5.     Port,Baud,StopBits,DataBits,Par: Integer;
  6.     Message: String[80];
  7.  
  8.   type
  9.     String19=String[19];
  10.  
  11. { A set of routines to enable COM1 and COM2 to be accessed from Turbo Pascal.
  12.   The following procedures are meant to be called by your programs:
  13.  
  14.   AssignAux(PortNumber in [1,2]) assigns Aux to COM1 or COM2
  15.   AssignUsr(PortNumber in [1,2]) assigns Usr to COM1 or COM2
  16.   SetSerial(PortNumber in [1,2],
  17.             BaudRate in [110,150,300,600,1200,2400,4800,9600],
  18.             StopBits in [1,2],
  19.             DataBits in [7,8],
  20.             Parity in [None,Even,Odd]) sets the baud rate, stop bits, data
  21.                                bits, and parity of one of the serial ports.
  22.  
  23.   The arrays InError and OutError may be examined to detect errors.  The bits
  24.   are as follows:
  25.      Bit 7 (128)        Time out (no device connected)
  26.      Bit 3 (8)          Framing error
  27.      Bit 2 (4)          Parity error
  28.      Bit 1 (2)          Overrun error
  29.  
  30.   Function SerialStatus(PortNumber in [1,2]) returns a more complete status:
  31.      Bit 15 (negative)  Time out (no device connected)
  32.      Bit 14 (16384)     Transmission shift register empty
  33.      Bit 13 (8192)      Transmission holding register empty
  34.      Bit 12 (4096)      Break detect
  35.      Bit 11 (2048)      Framing error
  36.      Bit 10 (1024)      Parity error
  37.      Bit 9  (512)       Overrun error
  38.      Bit 8  (256)       Data ready
  39.      Bit 7  (128)       Received line signal detect
  40.      Bit 6  (64)        Ring indicator
  41.      Bit 5  (32)        Data set ready
  42.      Bit 4  (16)        Clear to send
  43.      Bit 3  (8)         Delta receive line signal detect
  44.      Bit 2  (4)         Trailing edge ring detector
  45.      Bit 1  (2)         Delta data set ready
  46.      Bit 0  (1)         Delta clear to send
  47.  
  48.   Identifiers starting with "__" are not meant to be used by the user program.
  49. }
  50.  
  51.   Type
  52.     __RegisterSet=Record case Integer of
  53.                   1: (AX,BX,CX,DX,BP,DI,SE,DS,ES,Flags: Integer);
  54.                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  55.                 end;
  56.     __ParityType=(None,Even,Odd);
  57.  
  58.   var
  59.     __Regs: __RegisterSet;
  60.     InError,OutError: Array [1..2] of Byte;
  61.  
  62.   procedure __Int14(PortNumber,Command,Parameter: Integer);
  63.   { do a BIOS COM driver interrupt }
  64.  
  65.     begin
  66.       with __Regs do
  67.        begin
  68.         DX:=PortNumber-1;
  69.         AH:=Command;
  70.         AL:=Parameter;
  71.         Flags:=0;
  72.         Intr($14,__Regs);
  73.        end;
  74.     end;
  75.  
  76.  
  77.   procedure SetSerial(PortNumber,BaudRate,StopBits,DataBits: Integer;
  78.                       Parity: __ParityType);
  79.   { Set serial parameters on a COM port }
  80.  
  81.     var
  82.       Parameter: Integer;
  83.  
  84.     begin
  85.       case BaudRate of
  86.         110: BaudRate:=0;
  87.         150: BaudRate:=1;
  88.         300: BaudRate:=2;
  89.         600: BaudRate:=3;
  90.         1200: BaudRate:=4;
  91.         2400: BaudRate:=5;
  92.         4800: BaudRate:=6;
  93.         else BaudRate:=7; { Default to 9600 baud }
  94.        end;
  95.       if StopBits=2 then StopBits:=1
  96.       else StopBits:=0; { Default to 1 stop bit }
  97.       if DataBits=7 then DataBits:=2
  98.       else DataBits:=3; { Default to 8 data bits }
  99.       Parameter:=(BaudRate Shl 5)+(StopBits Shl 2)+DataBits;
  100.       case Parity of
  101.         Odd: Parameter:=Parameter+8;
  102.         Even: Parameter:=Parameter+24;
  103.         else; { Default to no parity }
  104.        end;
  105.       __Int14(PortNumber,0,Parameter);
  106.     end;
  107.  
  108.  
  109.   Function SerialStatus(PortNumber: Integer): Integer;
  110.   { Return the status of a COM port }
  111.  
  112.     begin
  113.       __Int14(PortNumber,3,0);
  114.       SerialStatus:=__Regs.AX;
  115.     end;
  116.  
  117.  
  118.   procedure __OutPort1(C: Byte);
  119.   { Called by Write to Aux or Usr when assigned to COM1 }
  120.  
  121.     begin
  122.       while (SerialStatus(1) and $30)=0 do ;
  123.       __Int14(1,1,C);
  124.       OutError[1]:=OutError[1] Or (__Regs.AH and $8E);
  125.     end;
  126.  
  127.  
  128.   procedure __OutPort2(C: Byte);
  129.   { Called by Write to Aux or Usr when assigned to COM2 }
  130.  
  131.     begin
  132.       while (SerialStatuS(2) and $30)=0 do ;
  133.       __Int14(2,1,C);
  134.       OutError[2]:=OutError[2] Or (__Regs.AH and $8E);
  135.     end;
  136.  
  137.  
  138.   Function __InPort1: Char;
  139.   { Called by Read from Aux or Usr when assigned to COM1 }
  140.  
  141.     begin
  142.       __Int14(1,2,0);
  143.       __InPort1:=Chr(__Regs.AL);
  144.       InError[1]:=InError[1] Or (__Regs.AH and $8E);
  145.     end;
  146.  
  147.  
  148.   Function __InPort2: Char;
  149.   { Called by Read from Aux or Usr when assigned to COM2 }
  150.  
  151.     begin
  152.       __Int14(2,2,0);
  153.       __InPort2:=Chr(__Regs.AL);
  154.       InError[2]:=InError[2] Or (__Regs.AH and $8E);
  155.     end;
  156.  
  157.  
  158.   procedure __AssignPort(PortNumber: Integer; var InPtr,OutPtr: Integer);
  159.   { Assign either Aux or Usr to either COM1 or COM2 }
  160.  
  161.     begin
  162.       if PortNumber=2 then
  163.        begin
  164.         OutPtr:=Ofs(__OutPort2);
  165.         InPtr:=Ofs(__InPort2);
  166.        end
  167.       else { Default to port 1 }
  168.        begin
  169.         OutPtr:=Ofs(__OutPort1);
  170.         InPtr:=Ofs(__InPort1);
  171.        end;
  172.       InError[PortNumber]:=0;
  173.       OutError[PortNumber]:=0;
  174.     end;
  175.  
  176.  
  177.   procedure AssignAux(PortNumber: Integer);
  178.   { Assign Aux to either COM1 or COM2 }
  179.  
  180.     begin
  181.       __AssignPort(PortNumber,AuxInPtr,AuxOutPtr);
  182.     end;
  183.  
  184.  
  185.   procedure AssignUsr(PortNumber: Integer);
  186.   { Assign Usr to either COM1 or COM2 }
  187.  
  188.  
  189.     begin
  190.       __AssignPort(PortNumber,UsrInPtr,UsrOutPtr);
  191.     end;
  192.  
  193.  
  194.   Function Binary(V: Integer): String19;
  195.  
  196.     var
  197.       I: Integer;
  198.       B: Array [0..3] of String[4];
  199.  
  200.     begin
  201.       For I:=0 To 15 do
  202.         if (V and (1 Shl (15-I)))<>0 then B[I Div 4][(I Mod 4)+1]:='1'
  203.         else B[I Div 4][(I Mod 4)+1]:='0';
  204.       For I:=0 To 3 do B[I][0]:=Chr(4);
  205.       Binary:=B[0]+' '+B[1]+' '+B[2]+' '+B[3];
  206.     end;
  207.  
  208.  
  209.   begin
  210.     Write('Enter port number:                    ');
  211.     ReadLn(Port);
  212.     AssignUsr(Port);
  213.     Write('Enter baud rate:                      ');
  214.     ReadLn(Baud);
  215.     Write('Enter stop bits:                      ');
  216.     ReadLn(StopBits);
  217.     Write('Enter data bits:                      ');
  218.     ReadLn(DataBits);
  219.     Write('Enter parity (0=none, 1=even, 2=odd): ');
  220.     ReadLn(Par);
  221.     Write('Enter message to print:               ');
  222.     ReadLn(Message);
  223.     SetSerial(1,Baud,StopBits,DataBits,__ParityType(Par));
  224.     WriteLn(Usr,Message);
  225.     WriteLn('OutError[',Port,']: ',Binary(OutError[Port]));
  226.     WriteLn('SerialStatus(',Port,'): ',Binary(SerialStatus(Port)));
  227.   end.
  228.